#!/usr/bin/env perl

# Generate definitions for all fuctions declared with extern in the header
# files that are specified with the STUB directive.
# The generated functions are defined with weak linking semantics, so they
# won't conflict when implemented in an object file that is linked.

use feature "switch";

# Set to 1 to print stub generation debugging info
my $DEBUG = 0;


sub debug {
    return unless $DEBUG;

    print STDERR "DEBUG: @_\n";
}


### Main program
die "Usage: $0 <sourcefile> <stubfile>\n" .
    "\tRead C <sourcefile>, get all files referred in a STUB: directive " .
    "and generate weakly linked 'empty' functions.\n"
    unless (@ARGV == 2);

my ($src_fn, $out_fn) = @ARGV;


my $stub_header = <<EOF;
/* Stub file, automatically generated by $0.
 * Command line:
 *  $0 @ARGV
 *
 * This file will be automatically regenerated by the Makefile. Manual changes
 * will be lost.
 */
EOF

my $stub_footer = <<EOF;
/* End of auto-generated function stubs */
EOF


### Find CC include path
# We run the preprocessor with an empty input file and verbose output. Then we
# parse the include search path out of the output.
# The gcc output we're interested in, appears on STDERR.
my $cpp_cmd = $ENV{CC} . ' -E'  # run preprocessor only
    . ' -v '                    # verbose output
    . $ENV{CFLAGS}              # CFLAGS, so we also capture -I<dir> directories
    . ' -'                      # read from STDIN
    . ' </dev/null'             # empty input
    . ' 2>&1 '                  # capture STDERR
    . ' >/dev/null'             # discard STDOUT
    ;
my @cpp_output = `$cpp_cmd`;
chomp @cpp_output;

# Add .. as first include search directory
my @cc_inc_path = ( '..' );

my $paths_found;
my $start_delim = '#include <...> search starts here:';
my $end_delim   = 'End of search list.';
for my $line (@cpp_output) {
    # Look for include path start delimiter
    if ($line =~ /\Q${start_delim}\E/) {
        $paths_found = 1;
        next;
    }

    # Look for include path end delimiter
    if ($line =~ /\Q${end_delim}\E/) {
        $paths_found = 0;
    }

    next unless $paths_found;

    # Trim whitespace
    $line =~ s/(?:^\s+|\s+$)//g;
    push @cc_inc_path, $line;
}


# Read test file and parse STUB directives
open my $in_fh,  '<', $src_fn or die "Could not open $src_fn for reading\n";
my @headers;
my @source;
while (<$in_fh>) {
    chomp;

    if (/\bSTUB\b/) {
        # Remove keyword and trailing punctuation/whitespace.
        s/^.+STUB\W+//;

        push @headers, split /\s+/;
    }
    if (/\bSOURCE\b/) {
        # Remove keyword and trailing punctuation/whitespace.
        s/^.+SOURCE\W+//;

        push @source, split /\s+/;
    }
}
close $in_fh;


open my $out_fh, '>', $out_fn or die "Could not open $out_fn for writing\n";
print $out_fh $stub_header, "\n";
print $out_fh "#include \"$_\"\n" for @headers;     # needed for non-primitive parameter/return type declarations
print $out_fh "\n";

for my $header (@headers) {
    # Look for file $header in all include directories $CC looks in
    $in_fh = undef;
    my $full_header_fn;
    for my $inc_dir ('.', @cc_inc_path) {   # search in ./ first
        # open returns nonzero on success, the undefined value otherwise.
        next unless open $in_fh, '<', $inc_dir . '/' . $header;

        $full_header_fn = $inc_dir . '/' . $header;
        last;
    }
    die "Could not find $header in include path (STUB directive in $src_fn)\n" unless $full_header_fn;

    print $out_fh "/*** Stubs for $header ($full_header_fn) ***/\n";
    debug "==== Header: $header";

    my $line = '';
    until (eof $in_fh) {
        $_ = <$in_fh>;
        chomp;

        # Handle preprocessor line continuations
        while (/\\$/ && !eof($in_fh)) {
            debug "Line continuation: [$_]";
            s/\\$//;            # Remove trailing backspace
            $_ .= <$in_fh>;     # ... and append next line
            chomp;
        }

        next if /^\s*#/;        # Skip preprocessor directives

        s|//.*||;               # Remove // style comments
        s/(?:^\s|\s$)+//g;      # Trim leading/trailing whitespace
        s/\s+/ /g;              # Condense multiple whitespace

        $line .= " $_";
        $_ = $line;

        my $cmt_open_count  = () = m|/\*|g;
        my $cmt_close_count = () = m|\*/|g;
        next unless $cmt_open_count == $cmt_close_count;    # Balance /* */ delimiters

        s|/\*.*?\*/||g;         # Remove /* */ style comments

        # Remove 'extern "C" {' block delimiters. The opening curly brace breaks
        # our parsing below.
        s/^\s*extern\s+"C"\s{//;

        # Balance { }. Because of the previous step, there might be one more
        # } than there are {'s.
        next unless tr/{// <= tr/}//;

        s/}/};/g;       # Add ; after every }, this makes the regexps below easier

        s/\s*LUALIB_API\s*//;   # Remove special markers
        s/\s+/ /g;              # Compress multiple spaces

        next unless /;\s*$/;    # Keep reading until ; line terminator is found
        next if /^\s*$/;        # Don't consider empty lines

        # Match function declaration
        if( /^\s*                   # Optional whitespace
            (?:extern\s+)?          # Optional 'extern' keyword
            (?<ret_type>            # Function return type: can be
                [\w\d\s_*]+         #   multiple words and include *
            )
            \b                      # Delimiting whitespace
            (?<func_name>           # Function name: everything between
                [^(\s]+             #   return type and first (
            )
            (?<func_params>         # Function parameters: including
                \(                  #   the surrounding ( ).
                [^;]+
            )
            ;
            \s*$
        /x) {
            # Save function signature: %+ is cleared when $func_name is trimmed
            # below.
            my ($ret_type, $func_name, $func_params) = @+{ qw(ret_type func_name func_params) };

            # Surrounding whitespace would introduce errors in the return type
            # checking and function name mangling that happens below.
            $ret_type  =~ s/(?:^\s+|\s+$)//g;
            $func_name =~ s/(?:^\s+|\s+$)//g;

            next if $ret_type =~ /^typedef/;        # function typedef gives false positive
            next if $ret_type =~ /^\s*$/;           # function-like preprocessor macro's

            print $out_fh "${ret_type} ${func_name} ${func_params} __attribute__ ((weak, alias(\"_stub_${func_name}\"))); ";

            # Remove __attribute__((...)) specifiers from the original function
            # declaration
            $func_params =~ s/__attribute__\(\(.*\)\)//;

            print $out_fh "${ret_type} _stub_${func_name} ${func_params} { ";
            print $out_fh "note(\"STUB called: $header: ${func_name}()\"); ";
            print $out_fh "return ";
            given (${ret_type})     {
                when ('void')       { break; }
                when (/\*$/)        { print $out_fh 'NULL'; }
                when (/u?int(?:(?:8|16|32|64)_t)?/)
                                    { print $out_fh '0'; }
                when (/(?:un)?signed/)
                                    { print $out_fh '0'; }
                when (/s?size_t/)   { print $out_fh '0'; }
                when (/^enum\s/)    { print $out_fh "(${ret_type})0"; }

                when ('rnd_func_t') { print $out_fh 'NULL'; }   # typedef'ed function pointer
                when ('rte_usage_hook_t') { print $out_fh 'NULL'; } # typedef'ed function pointer
                when ('phys_addr_t')    { print $out_fh '0'; }      # typedef'ed uint64_t

                default             { die "Don't know what value to return for type '$_'"
                                        . " (file '$full_header_fn'; line was [$line])\n"
                                        . " Parsed function: [$ret_type] [$func_name] [$func_params]\n"; }
            }
            print $out_fh "; }\n";
        }

        $line = '';
    }
    close $in_fh;

    print $out_fh "\n";
}
print $out_fh $stub_footer;
close $out_fh;


# Header file for test source. This file includes sections marked in the SOURCE
# directive files.
(my $hdr_fn = 'build/' . $src_fn) =~ s/\.c$/\.h/;
open my $hdr_fh, '>', $hdr_fn or die "Could not open $hdr_fn for writing\n";
print $hdr_fh "/*** Header file for $src_fn ***/\n";
print $hdr_fh "\n";

for my $source (@source) {
    # Look for file $source in all include directories $CC looks in
    $in_fh = undef;
    my $full_source_fn;
    for my $inc_dir ('.', @cc_inc_path) {   # search in ./ first
        # open returns nonzero on success, the undefined value otherwise.
        next unless open $in_fh, '<', $inc_dir . '/' . $source;

        $full_source_fn = $inc_dir . '/' . $source;
        last;
    }
    die "Could not find $source in include path (SOURCE directive in $src_fn)\n" unless $full_source_fn;

    (my $src_header = $source) =~ s/\.c$/.h/;

    print $hdr_fh "/*** Included parts of $source ($full_source_fn) ***/\n";
    print $hdr_fh "#include \"", $src_header, "\"\n\n";

    my $include_line = 0;
    while (<$in_fh>) {
        # Start of include section marker
        if (/TEST_INCLUDE_START/) {
            $include_line = 1;
            next;
        }

        # End of include section marker
        if (/TEST_INCLUDE_END/) {
            $include_line = 0;
        }

        print $hdr_fh $_ if $include_line;
    }
    close $in_fh;

    print $hdr_fh "\n";
}
close $hdr_fh;
